home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 08 - 1992 / 08.06 Oct 92 / Long Text Lists / BLObject.P < prev   
Encoding:
Text File  |  1992-03-26  |  58.8 KB  |  2,370 lines  |  [TEXT/MPS ]
  1. UNIT BLObject;
  2. {••••• Objects, plus a few utility routines •••••}
  3.  
  4. INTERFACE
  5.  
  6. USES  Memtypes,QuickDraw,OSIntf,ToolIntf,
  7.       PackIntf,FixMath,ObjIntf;
  8.  
  9. CONST menuCount     =   5;
  10.       ovalSize      =  16;  {For “FrameRoundRect”}
  11.       shadow3Doff   =   3;
  12.       shadow3Don    =   1;
  13.       shadow3Ddiff  = shadow3Doff - shadow3Don;
  14.       minBtnHeight  =  16;
  15.       minBtnDescent =   4;
  16.       scrWidth      =  15;
  17.       scrBarMax     =1000;
  18.       noItemHit     =  -1;
  19.       hiliteMode    =$938;    {Color highlighting}
  20.       textMarge     =   4;
  21.       null          = CHR(0);
  22.       vertListDelay =   4;
  23.       threeDDelay   =   2;
  24.       feedbackDelay =  10;
  25.       animThreshold =   2;  {Ticks between frames}
  26.       listKeyLeng   =  15;
  27.       doubleClick   =   1;
  28.       endOfStyle    =   9;
  29.       origV  =  40;
  30.       origH  =   2;
  31.       toggleOff   =  0;
  32.       toggleOn    =  1;
  33.       scrBarShow  =    0;
  34.       scrBarHide  =  255;
  35.       {------------- RESOURCE ID’S --------------}
  36.       alert1ID    =  129;
  37.       blApplID    = 1000;
  38.       exclamationBaseID = 1000;
  39.       exclamationNumber =    7; {Number of frames}
  40.       {------------- Menu resources -------------}
  41.       applMID  =  1001;
  42.       fileMID  =  applMID + 1;
  43.       editMID  =  fileMID + 1;
  44.       fontMID  =  editMID + 1;
  45.       stylMID  =  fontMID + 1;
  46.  
  47. TYPE
  48.    Str1        =  String[1];
  49.    StrListKey  =  String[listKeyLeng];
  50.    CharacterSet=  SET OF CHAR;
  51.    FontIdent   =  PACKED RECORD
  52.                      n : INTEGER;    {Font number}
  53.                      s : Byte;         {Font size}
  54.                      y : Style;       {Font style}
  55.                   END;
  56.    MouseIndex  =  (before, now);
  57.    MouseFlags  =
  58.       PACKED ARRAY[MouseIndex] OF BOOLEAN;
  59.    ActivationType =  (active, enable, animate);
  60.    PDItemFlagType =
  61.       PACKED ARRAY[ActivationType] OF BOOLEAN;
  62.  
  63.    {------------------ Objects ------------------}
  64.    TPseudoDialog = OBJECT (TObject)
  65.       fWindow : WindowPtr;
  66.       fItems  : TPDialogItem;
  67.       fActive : BOOLEAN;
  68.       PROCEDURE Free; OverRide;
  69.       PROCEDURE IPseudoDialog
  70.                 (iBounds : Rect;
  71.                   iTitle : Str255;
  72.                  iWithGA : BOOLEAN;
  73.                    iFont : FontIdent);
  74.       PROCEDURE InstallItem(chose : TPDialogItem);
  75.       PROCEDURE ItemInformation;
  76.       PROCEDURE EnableDisableItem
  77.                 (index : INTEGER);
  78.       PROCEDURE AnimateStuff;
  79.       PROCEDURE DrawBorder;
  80.       PROCEDURE ActivateWindow;
  81.       PROCEDURE DeactivateWindow;
  82.       PROCEDURE UpdateWindKernel;
  83.       PROCEDURE UpdateWindow;
  84.       PROCEDURE Idling;
  85.       PROCEDURE SetFont;
  86.       FUNCTION  Keying(c : CHAR;
  87.                    modif : INTEGER) : LongInt;
  88.       FUNCTION  MouseInContent(p : Point;
  89.                 modif : INTEGER) : LongInt;
  90.       PROCEDURE MouseInDrag(p : Point);
  91.       FUNCTION  HandleMouseEvents
  92.                      (p : Point;
  93.                   modif : INTEGER;
  94.                 thePart : INTEGER) : LongInt;
  95.       PROCEDURE RequestResponse
  96.                 (theItem, theKind : INTEGER);
  97.    END;
  98.  
  99.    TPDialogItem = OBJECT (TObject)
  100.       fNexThing : TPDialogItem;
  101.       fItsValue : INTEGER;
  102.       fFlag     : PDItemFlagType;
  103.       fBorder   : Rect;
  104.       PROCEDURE Free; OverRide;
  105.       PROCEDURE IPDialogItem(iBorder : Rect);
  106.       FUNCTION  Information : Str255;
  107.       PROCEDURE EnableDisable(index : INTEGER);
  108.       PROCEDURE AnimateIt;
  109.       PROCEDURE GetRectangle(VAR r : Rect);
  110.       PROCEDURE Draw;
  111.       PROCEDURE UpdateIt;
  112.       PROCEDURE ActivateIt;
  113.       PROCEDURE DeactivateIt;
  114.       PROCEDURE Idle;
  115.       PROCEDURE SetItemFont;
  116.       FUNCTION  Click(p : Point;
  117.                   modif : INTEGER) : LongInt;
  118.       FUNCTION  KeyIt(c : CHAR;
  119.                   modif : INTEGER) : LongInt;
  120.       PROCEDURE Response(theItem,
  121.                          theKind : INTEGER);
  122.    END;
  123.  
  124.    TVerticalList = OBJECT (TPDialogItem)
  125.       fLength,             {Entries in list}
  126.       fSelect,             {Nº of selected entry}
  127.       fOffLin : LongInt;   {Scrolled off top}
  128.       fOffByt : LongInt;   {Before first visible}
  129.       fData   : Handle;    {The entries}
  130.       fFont   : FontIdent;
  131.       fHeight,             {Cell height, pixels}
  132.       fDescent: INTEGER;   {Font descent, pixels}
  133.       fPort   : WindowPtr;
  134.       fScroll : ControlHandle;
  135.  
  136.       fUserHitKeys : StrListKey;
  137.       fLastKeyTime : LongInt;
  138.  
  139.       PROCEDURE Free; OverRide;
  140.       PROCEDURE IVerticalList
  141.                 (iBorder : Rect;
  142.                    iPort : WindowPtr);
  143.       FUNCTION  Information : Str255; OverRide;
  144.       PROCEDURE SetMeasures;
  145.       PROCEDURE GetRectangle(VAR r : Rect);
  146.                 OverRide;
  147.       FUNCTION  VisibleLines : INTEGER;
  148.       PROCEDURE InstallData(theText : Handle);
  149.       PROCEDURE DrawOneEntry(x,y : LongInt);
  150.       PROCEDURE DrawEntries;
  151.       FUNCTION  GetSelection : Str63;
  152.       PROCEDURE SelectionRectangle(VAR r : Rect);
  153.       PROCEDURE HiliteSelection;
  154.       PROCEDURE ActivationSel(activate : BOOLEAN);
  155.       PROCEDURE DrawEntsAndSel;
  156.       PROCEDURE DrawBorder;
  157.       PROCEDURE Draw; OverRide;
  158.       PROCEDURE ActivateIt; OverRide;
  159.       PROCEDURE DeactivateIt; OverRide;
  160.       PROCEDURE SetItemFont; OverRide;
  161.       PROCEDURE CheckScrollability;
  162.       PROCEDURE SetScrollValue;
  163.       PROCEDURE OneLineLess;
  164.       PROCEDURE OneLineMore;
  165.       PROCEDURE RecalOffByte;
  166.       PROCEDURE OnePageLess;
  167.       PROCEDURE OnePageMore;
  168.       PROCEDURE Thumbing(p : Point);
  169.       PROCEDURE Scrolling(part : INTEGER);
  170.       PROCEDURE DragSelecting;
  171.       FUNCTION  Click(p : Point;
  172.                   modif : INTEGER) : LongInt;
  173.                   OverRide;
  174.       PROCEDURE CancelSelection;
  175.       PROCEDURE SetSelection(newSel : LongInt);
  176.       PROCEDURE ShowSelection;
  177.       PROCEDURE InitKeyStuff;
  178.       PROCEDURE SelectCellStart(c : CHAR);
  179.       FUNCTION  KeyIt(c : CHAR;
  180.                   modif : INTEGER) : LongInt;
  181.                   OverRide;
  182.       PROCEDURE Response(theItem,
  183.                 theKind : INTEGER); OverRide;
  184.       PROCEDURE Resize(hauteur : INTEGER);
  185.    END;
  186.  
  187.    TPlainButton = OBJECT (TPDialogItem)
  188.       fTitle : Str15;
  189.       fEquiv : PACKED ARRAY[1..2] OF CHAR;
  190.       fFont  : FontIdent;
  191.       PROCEDURE IPlainButton(iBorder : Rect;
  192.                               iTitle : Str15;
  193.                               iEquiv : CHAR;
  194.                                iFont : FontIdent);
  195.       FUNCTION  KeyInfo : Str15;
  196.       FUNCTION  ButtonInfo : Str255;
  197.       FUNCTION  Information : Str255; OverRide;
  198.       FUNCTION  ExtraHeight : INTEGER;
  199.       PROCEDURE DrawTitle(r : Rect);
  200.       PROCEDURE Draw; OverRide;
  201.       PROCEDURE ActivateIt; OverRide;
  202.       PROCEDURE DeactivateIt; OverRide;
  203.       FUNCTION  Click(p : Point;
  204.                   modif : INTEGER) : LongInt;
  205.                   OverRide;
  206.       PROCEDURE Invert(r : Rect);
  207.       FUNCTION  MouseReleasedHere : BOOLEAN;
  208.       PROCEDURE VisualFeedback;
  209.       FUNCTION  KeyIt(c : CHAR;
  210.                   modif : INTEGER) : LongInt;
  211.                   OverRide;
  212.    END;
  213.  
  214.    TToggleButton = OBJECT (TPlainButton)
  215.       fStatus : INTEGER;
  216.       PROCEDURE IToggleButton(iBorder : Rect;
  217.                                iTitle : Str15;
  218.                                iEquiv : CHAR;
  219.                                 iFont : FontIdent;
  220.                               iStatus : INTEGER);
  221.       FUNCTION  ButtonInfo : Str255; OverRide;
  222.       FUNCTION  ExtraHeight : INTEGER; OverRide;
  223.       PROCEDURE Draw; OverRide;
  224.       FUNCTION  Click(p : Point;
  225.                   modif : INTEGER) : LongInt;
  226.                   OverRide;
  227.       PROCEDURE VisualFeedback; OverRide;
  228.    END;
  229.  
  230.    TThreeDButton = OBJECT (TPlainButton)
  231.       PROCEDURE IThreeDButton
  232.                 (iBorder : Rect;
  233.                   iTitle : Str15;
  234.                   iEquiv : CHAR;
  235.                    iFont : FontIdent);
  236.       FUNCTION  ButtonInfo : Str255; OverRide;
  237.       FUNCTION  ExtraHeight : INTEGER; OverRide;
  238.       PROCEDURE FancyBorder(r : Rect;
  239.                       hilited : BOOLEAN);
  240.       PROCEDURE DropShadow(r : Rect;
  241.                        depth : INTEGER);
  242.       PROCEDURE Draw; OverRide;
  243.       PROCEDURE PushDown(VAR r : Rect;
  244.                          depth : INTEGER);
  245.       PROCEDURE PopUp(VAR r : Rect;
  246.                       depth : INTEGER);
  247.       FUNCTION  MouseReleasedHere : BOOLEAN;
  248.                 OverRide;
  249.       PROCEDURE VisualFeedback; OverRide;
  250.    END;
  251.  
  252.    TToggl3DButton = OBJECT (TThreeDButton)
  253.       fStatus : INTEGER;
  254.       PROCEDURE IToggl3DButton
  255.                 (iBorder : Rect;
  256.                   iTitle : Str15;
  257.                   iEquiv : CHAR;
  258.                    iFont : FontIdent;
  259.                  iStatus : INTEGER);
  260.       FUNCTION  ButtonInfo : Str255; OverRide;
  261.       PROCEDURE Draw; OverRide;
  262.       FUNCTION  MouseReleasedHere : BOOLEAN;
  263.                 OverRide;
  264.       FUNCTION  Click(p : Point;
  265.                   modif : INTEGER) : LongInt;
  266.                   OverRide;
  267.       PROCEDURE VisualFeedback; OverRide;
  268.    END;
  269.  
  270.    TIcon = OBJECT (TPDialogItem)
  271.       fIconID : INTEGER;
  272.       PROCEDURE IIcon(iBorder : Rect;
  273.                       iIconID : INTEGER);
  274.       FUNCTION  Information : Str255; OverRide;
  275.       PROCEDURE Draw; OverRide;
  276.    END;
  277.  
  278.    TAnimation = OBJECT (TPDialogItem)
  279.       fBaseID  : INTEGER;
  280.       fNumber  : INTEGER;
  281.       fCurrent : INTEGER;
  282.       fForward : BOOLEAN; {Direction of animation}
  283.       fLastTim : LongInt;
  284.       PROCEDURE IAnimation(iBorder : Rect;
  285.                            iBaseID : INTEGER;
  286.                            iNumber : INTEGER);
  287.       FUNCTION  Information : Str255; OverRide;
  288.       PROCEDURE NextFrame;
  289.       PROCEDURE Idle; OverRide;
  290.       PROCEDURE Draw; OverRide;
  291.    END;
  292.  
  293.    TStaticText = OBJECT (TPDialogItem)
  294.       fContents : Str255;
  295.       fFont     : FontIdent;
  296.       PROCEDURE IStaticText(iBorder : Rect;
  297.                               iFont : FontIdent;
  298.                           iContents : Str255);
  299.       FUNCTION  Information : Str255; OverRide;
  300.       PROCEDURE DrawBorder;
  301.       PROCEDURE Draw; OverRide;
  302.       PROCEDURE ActivateIt; OverRide;
  303.       PROCEDURE DeactivateIt; OverRide;
  304.    END;
  305.  
  306. VAR
  307.    myMenus    : ARRAY[1..menuCount] OF MenuHandle;
  308.    theFontMenu,
  309.    theStylMenu: MenuHandle;
  310.    styleVector: PACKED ARRAY[2..8] OF StyleItem;
  311.    fakeDlg    : TPseudoDialog;
  312.    theEvent   : EventRecord;
  313.    weAreDone,
  314.    inBckGrnd,
  315.    wneExists,
  316.    dublClick  : BOOLEAN;
  317.    forNowFI,
  318.    defaultFI  : FontIdent;
  319.    entr,
  320.    cRet,
  321.    left,
  322.    right,
  323.    up,
  324.    down,
  325.    blnkChr    : CHAR;
  326.    blnkPtr    : Ptr;
  327.    zoomArea,
  328.    dragArea   : Rect;
  329.    XCursor,
  330.    waitCursor : CursHandle;
  331.    lastClikPoint : Point;
  332.    lastClikTime  : LongInt;
  333.  
  334. PROCEDURE SetFontIdent(font : FontIdent);
  335. PROCEDURE SetFontSizeFace(fn,fs : INTEGER;
  336.                              fy : Style);
  337. PROCEDURE GetFontIdent(VAR font : FontIdent);
  338. PROCEDURE SetFontMenu;
  339. PROCEDURE SetSizeMenu;
  340. PROCEDURE SetStylMenu;
  341. PROCEDURE FontMenuEvent(theItem : INTEGER);
  342. PROCEDURE StyleMenuEvent(theItem : INTEGER);
  343.  FUNCTION MakeStr1(c : CHAR) : Str1;
  344.  FUNCTION IntString(x : LongInt)  :  Str15;
  345.  FUNCTION StringInt(s : Str15) : LongInt;
  346.  FUNCTION NumericStr(s : Str255)  :  BOOLEAN;
  347. PROCEDURE MyInvertRect(r : Rect);
  348. PROCEDURE RestoreClip;
  349. PROCEDURE FrameTop(r : Rect);
  350. PROCEDURE FrameBot(r : Rect);
  351. PROCEDURE CentreRect(VAR r : Rect);
  352.  FUNCTION ScrollBarShowHide(b : BOOLEAN) : Byte;
  353. PROCEDURE SimpleAlert(s : Str255);
  354.  FUNCTION GetKind(w : WindowPtr) : INTEGER;
  355. PROCEDURE CheckMultipleClicks(p : Point);
  356.  
  357. IMPLEMENTATION
  358. {$S Main}
  359. {••••••••••••••••••••••••••••••••••••••••••••••••}
  360. { Routines for getting and setting the font,     }
  361. { font size, and font style in the current port. }
  362. {••••••••••••••••••••••••••••••••••••••••••••••••}
  363. PROCEDURE SetFontIdent(font : FontIdent);
  364. BEGIN
  365.    WITH font DO BEGIN
  366.       TextFont(n);
  367.       TextSize(s);
  368.       TextFace(y);
  369.    END;
  370. END;
  371.  
  372. PROCEDURE SetFontSizeFace(fn,fs : INTEGER;
  373.                              fy : Style);
  374. BEGIN
  375.    TextFont(fn);
  376.    TextSize(fs);
  377.    TextFace(fy);
  378. END;
  379.  
  380. PROCEDURE GetFontIdent(VAR font : FontIdent);
  381. BEGIN
  382.    WITH font,thePort^ DO BEGIN
  383.       n:= txFont;
  384.       s:= txSize;
  385.       y:= txFace;
  386.    END;
  387. END;
  388.  
  389. {••••••••••••••••••••••••••••••••••••••••••••••••}
  390. { Routines which manage the Font and Style menus,}
  391. { including highlighting of font sizes in second }
  392. { half of Style menu. The current font, size and }
  393. { style are stored in global “forNowFI”.         }
  394. {••••••••••••••••••••••••••••••••••••••••••••••••}
  395. PROCEDURE SetFontMenu;
  396. VAR   fontName,
  397.       itemName  :  Str255;
  398.       i,size    :  INTEGER;
  399. BEGIN
  400.    GetFontName(forNowFI.n,fontName);
  401.    i:= CountMItems(theFontMenu);
  402.    WHILE i > 0 DO BEGIN
  403.       GetItem(theFontMenu,i,itemName);
  404.       CheckItem(theFontMenu,i,itemName=fontName);
  405.       i:= i - 1;
  406.    END;
  407.    i:= CountMItems(theStylMenu);
  408.    WHILE i > endOfStyle DO BEGIN
  409.       GetItem(theStylMenu,i,itemName);
  410.       IF NumericStr(itemName) THEN BEGIN
  411.          size:= StringInt(itemName);
  412.          IF RealFont(forNowFI.n,size) THEN
  413.             SetItemStyle(theStylMenu,
  414.             i,[bold,outline])
  415.          ELSE SetItemStyle(theStylMenu,i,[]);
  416.       END;
  417.       i:= i - 1;
  418.    END;
  419. END;
  420.  
  421. PROCEDURE SetSizeMenu;
  422. VAR   i  :  INTEGER;
  423.       fSize  :  String[3];
  424.       iSize  :  Str255;
  425. BEGIN
  426.    fSize:= IntString(forNowFI.s);
  427.    i:= CountMItems(theStylMenu);
  428.    WHILE i > endOfStyle DO BEGIN
  429.       GetItem(theStylMenu,i,iSize);
  430.       CheckItem(theStylMenu,i,iSize = fSize);
  431.       i:= i - 1;
  432.    END;
  433. END;
  434.  
  435. PROCEDURE SetStylMenu;
  436. VAR   i  :  INTEGER;
  437. BEGIN
  438.    CheckItem(theStylMenu,1,(forNowFI.y = []));
  439.    FOR i:= 2 TO endOfStyle-1 DO CheckItem
  440.       (theStylMenu,i,
  441.        (styleVector[i] IN forNowFI.y));
  442. END;
  443.  
  444. {••••••••••••••••••••••••••••••••••••••••••••••••}
  445. { Routines which respond to mouse hits in the    }
  446. { Font and Style menus.                          }
  447. {••••••••••••••••••••••••••••••••••••••••••••••••}
  448. PROCEDURE FontMenuEvent(theItem : INTEGER);
  449. VAR   theName  :  Str255;
  450. BEGIN
  451.    GetItem(theFontMenu,theItem,theName);
  452.    GetFNum(theName,theItem);
  453.    IF theItem <> forNowFI.n THEN BEGIN
  454.       forNowFI.n:= theItem;
  455.       SetFontMenu;
  456.    END;
  457. END;
  458.  
  459. PROCEDURE StyleMenuEvent(theItem : INTEGER);
  460. VAR   theName  :  Str255;
  461.       theStyle :  StyleItem;
  462. BEGIN
  463.    IF theItem < endOfStyle THEN BEGIN
  464.       IF theItem = 1 THEN forNowFI.y:= []
  465.       ELSE BEGIN
  466.          theStyle:= styleVector[theItem];
  467.          IF theStyle IN forNowFI.y THEN
  468.             forNowFI.y:= forNowFI.y - [theStyle]
  469.          ELSE BEGIN
  470.             forNowFI.y:= forNowFI.y + [theStyle];
  471.             IF theStyle = condense THEN
  472.                forNowFI.y:= forNowFI.y - [extend]
  473.             ELSE IF theStyle = extend THEN
  474.                forNowFI.y:= forNowFI.y-[condense];
  475.          END;
  476.       END;
  477.       SetStylMenu;
  478.    END
  479.    ELSE IF theItem > endOfStyle THEN BEGIN
  480.       GetItem(theStylMenu,theItem,theName);
  481.       IF NumericStr(theName) THEN BEGIN
  482.          theItem:= StringInt(theName);
  483.          IF theItem <> forNowFI.s THEN BEGIN
  484.             forNowFI.s:= theItem;
  485.             SetSizeMenu;
  486.          END;
  487.       END
  488.       ELSE SysBeep(1);
  489.    END;
  490. END;
  491.  
  492. {••••••••••••••••••••••••••••••••••••••••••••••••}
  493. { Various string-conversion routines.            }
  494. {••••••••••••••••••••••••••••••••••••••••••••••••}
  495. FUNCTION MakeStr1(c : CHAR) : Str1;
  496. VAR   s  :  Str1;
  497. BEGIN
  498.    s[0]:= CHR(1);
  499.    s[1]:= c;
  500.    MakeStr1:= s;
  501. END;
  502.  
  503. { “IntString” converts "x" to string. }
  504. FUNCTION IntString(x : LongInt)  :  Str15;
  505. VAR   s  :  Str255;
  506. BEGIN
  507.    NumToString(x,s);
  508.    IF Length(s) > 15 THEN s[0]:= CHR(15);
  509.    IntString:= s;
  510. END;
  511.  
  512. { “StringInt” converts numeric “s” to LongInt}
  513. FUNCTION StringInt(s : Str15) : LongInt;
  514. VAR   x  :  LongInt;
  515. BEGIN StringToNum(s,x); StringInt:= x; END;
  516.  
  517. { “NumericStr” is a Boolean function, TRUE
  518.   if and only if “s” is entirely numeric,
  519.   with no leading sign, & of length at least 1. }
  520. FUNCTION NumericStr(s : Str255)  :  BOOLEAN;
  521. VAR   i  :  INTEGER;
  522. BEGIN
  523.    NumericStr:= FALSE;  {Default}
  524.    i:= Length(s);
  525.    IF i = 0 THEN Exit(NumericStr);
  526.    REPEAT
  527.       IF NOT (s[i] IN ['0'..'9']) THEN
  528.          Exit(NumericStr);
  529.       i:= i - 1;
  530.    UNTIL i = 0;
  531.    NumericStr:= TRUE;
  532. END;
  533.  
  534. {••••••••••••••••••••••••••••••••••••••••••••••••}
  535. { Various graphic routines.                      }
  536. {••••••••••••••••••••••••••••••••••••••••••••••••}
  537. PROCEDURE MyInvertRect(r : Rect);
  538. BEGIN
  539.    BitClr(Ptr(hiliteMode),pHiliteBit);
  540.    InvertRect(r);
  541. END;
  542.  
  543. PROCEDURE RestoreClip;
  544. VAR   i  :  INTEGER;
  545.       r  :  Rect;
  546. BEGIN
  547.    i:= MaxInt DIV 2;
  548.    SetRect(r,-i,-i,i,i);
  549.    ClipRect(r);
  550. END;
  551.  
  552. PROCEDURE FrameTop(r : Rect);
  553. BEGIN
  554.    MoveTo(r.left,   r.bottom-1);
  555.    LineTo(r.left,   r.top);
  556.    LineTo(r.right-1,r.top);
  557. END;
  558.  
  559. PROCEDURE FrameBot(r : Rect);
  560. BEGIN
  561.    MoveTo(r.left,   r.bottom-1);
  562.    LineTo(r.right-1,r.bottom-1);
  563.    LineTo(r.right-1,r.top);
  564. END;
  565.  
  566. PROCEDURE CentreRect(VAR r : Rect);
  567. VAR   x,y  :  INTEGER;
  568. BEGIN
  569.    WITH zoomArea DO BEGIN
  570.       x:= ((right -left)-(r.right -r.left)) DIV 2;
  571.       y:= ((bottom-top )-(r.bottom-r.top )) DIV 2;
  572.    END;
  573.    OffsetRect(r,x,y+origV);
  574. END;
  575.  
  576. FUNCTION ScrollBarShowHide(b : BOOLEAN) : Byte;
  577. BEGIN
  578.    IF b THEN ScrollBarShowHide:= scrBarShow
  579.         ELSE ScrollBarShowHide:= scrBarHide;
  580. END;
  581.  
  582. {••••••••••••••••••••••••••••••••••••••••••••••••}
  583. { Miscellaneous routines……                       }
  584. {••••••••••••••••••••••••••••••••••••••••••••••••}
  585. { Alert box with one message & OK button }
  586. PROCEDURE SimpleAlert(s : Str255);
  587. VAR   g :  GrafPtr;
  588. BEGIN
  589.    GetPort(g);
  590.    SetCursor(arrow);
  591.    ParamText(s,'','','');
  592.    IF NoteAlert(alert1ID,NIL) = ok THEN {Nada};
  593.    SetCursor(waitCursor^^);
  594.    SetPort(g);
  595. END;
  596.  
  597. { Returns windowKind of “w”. Zero if “w” is NIL.}
  598. FUNCTION GetKind(w : WindowPtr) : INTEGER;
  599. BEGIN
  600.    IF w = NIL THEN GetKind:= 0
  601.    ELSE GetKind:= WindowPeek(w)^.windowKind;
  602. END;
  603.  
  604. { Check for double clicks }
  605. PROCEDURE CheckMultipleClicks(p : Point);
  606. CONST clickSeuil = 4;
  607. BEGIN
  608.    dublClick:=
  609.       (theEvent.when-lastClikTime) <= GetDblTime;
  610.    IF dublClick THEN BEGIN
  611.       SubPt(lastClikPoint,p);
  612.       dublClick:= (ABS(p.h) < clickSeuil) AND
  613.                   (ABS(p.v) < clickSeuil);
  614.       { Don’t report a double-click until
  615.         the mouse button is released. }
  616.       IF dublClick THEN
  617.          REPEAT UNTIL NOT WaitMouseUp;
  618.    END;
  619.    lastClikPoint:= theEvent.where;
  620.    lastClikTime := theEvent.when;
  621. END;
  622.  
  623. { Encode low-word & high-word into a LongInt }
  624. FUNCTION MakeLongInt(lo,hi : INTEGER) : LongInt;
  625. BEGIN MakeLongInt:= lo + hi*$00010000; END;
  626.  
  627. {••••••••••••••••••••••••••••••••••••••••••••••••}
  628. { METHODS OF OBJECT TYPE “TPseudoDialog”.        }
  629. {••••••••••••••••••••••••••••••••••••••••••••••••}
  630. PROCEDURE TPseudoDialog.Free;
  631. VAR   p  :  Ptr;
  632. BEGIN
  633.    IF fItems <> NIL THEN fItems.Free;
  634.    p:= Ptr(fWindow);
  635.    CloseWindow(fWindow);
  636.    DisposPtr(p);
  637.    INHERITED Free;
  638. END;
  639.  
  640. PROCEDURE TPseudoDialog.IPseudoDialog
  641.                    (iBounds : Rect;
  642.                      iTitle : Str255;
  643.                     iWithGA : BOOLEAN;
  644.                       iFont : FontIdent);
  645. VAR   wStorage  :  Ptr;
  646. BEGIN
  647.    wStorage:= NewPtr(SizeOf(WindowRecord));
  648.    IF wStorage = NIL THEN ExitToShell;
  649.    fWindow:= NewWindow(wStorage,iBounds,
  650.       iTitle,FALSE,noGrowDocProc,
  651.       WindowPtr(-1),iWithGA,ORD(SELF));
  652.    SetPort(fWindow);
  653.    SetFontIdent(iFont);
  654.    fItems:= NIL;
  655.    fActive:= FALSE;
  656. END;
  657.  
  658. { Install “chose” at end of linked list
  659.   headed by “fItems”;
  660.   also initialize “chose.fItsValue”.}
  661. PROCEDURE TPseudoDialog.InstallItem
  662.           (chose : TPDialogItem);
  663. VAR   scan  :  TPDialogItem;
  664. BEGIN
  665.    IF fItems = NIL THEN BEGIN
  666.       chose.fItsValue:= 1;
  667.       fItems:= chose;
  668.    END
  669.    ELSE BEGIN
  670.       chose.fItsValue:= 2;
  671.       scan:= fItems;
  672.       WHILE scan.fNexThing <> NIL DO BEGIN
  673.          chose.fItsValue:= chose.fItsValue + 1;
  674.          scan:= scan.fNexThing;
  675.       END;
  676.       scan.fNexThing:= chose;
  677.    END;
  678. END;
  679.  
  680. PROCEDURE TPseudoDialog.ItemInformation;
  681. CONST lineHeight = 15;
  682. VAR   w  :  WindowPtr;
  683.       r  :  Rect;
  684.       s  :  Str255;
  685.       p  :  TPDialogItem;
  686.       i  :  INTEGER;
  687. BEGIN
  688.    DeactivateWindow;
  689.    SetRect(r,0,0,420,250);  CentreRect(r);
  690.    GetWTitle(fWindow,s);
  691.    s:= Concat('Items in “',s,'”');
  692.    w:= NewWindow(NIL,r,s,TRUE,noGrowDocProc,
  693.       WindowPtr(-1),FALSE,0);
  694.    SetPort(w);
  695.    SetFontSizeFace(geneva,9,[bold]);
  696.    i:= 0;
  697.    r:= w^.portRect;  r.left:= r.left + 5;
  698.    p:= fItems;
  699.    WHILE p <> NIL DO BEGIN
  700.       i:= i + 1;
  701.       r.top:= r.top + lineHeight;
  702.       MoveTo(r.left,r.top);
  703.       s:= p.Information;
  704.       s:= Concat(IntString(i),'. ',s);
  705.       IF i < 10 THEN s:= Concat(blnkChr,s);
  706.       DrawString(s);
  707.       p:= p.fNexThing;
  708.    END;
  709.    REPEAT SystemTask UNTIL Button;
  710.    FlushEvents(everyEvent,0);
  711.    DisposeWindow(w);
  712. END;
  713.  
  714. PROCEDURE TPseudoDialog.EnableDisableItem
  715.           (index : INTEGER);
  716. BEGIN
  717.    IF fItems <> NIL THEN BEGIN
  718.       SetPort(fWindow);
  719.       fItems.EnableDisable(index);
  720.    END;
  721. END;
  722.  
  723. PROCEDURE TPseudoDialog.AnimateStuff;
  724. BEGIN
  725.    IF fItems <> NIL THEN BEGIN
  726.       SetPort(fWindow);
  727.       fItems.AnimateIt;
  728.    END;
  729. END;
  730.  
  731. PROCEDURE TPseudoDialog.DrawBorder;
  732. VAR   r  :  Rect;
  733. BEGIN
  734.    r:= fWindow^.portRect;
  735.    InsetRect(r,2,2);
  736.    PenSize(2,2);
  737.    IF fActive THEN PenPat(black)
  738.               ELSE PenPat(gray);
  739.    FrameRect(r);
  740.    PenNormal;
  741. END;
  742.  
  743. PROCEDURE TPseudoDialog.ActivateWindow;
  744. BEGIN
  745.    {Following line prevents multiple activation}
  746.    IF fActive THEN Exit(ActivateWindow);
  747.    fActive:= TRUE;
  748.    SetPort(fWindow);
  749.    DrawBorder;
  750.    IF fItems <> NIL THEN fItems.ActivateIt;
  751. END;
  752.  
  753. PROCEDURE TPseudoDialog.DeactivateWindow;
  754. BEGIN
  755.    {Following line prevents multiple deactivation}
  756.    IF NOT fActive THEN Exit(DeactivateWindow);
  757.    fActive:= FALSE;
  758.    SetPort(fWindow);
  759.    DrawBorder;
  760.    IF fItems <> NIL THEN fItems.DeactivateIt;
  761. END;
  762.  
  763. PROCEDURE TPseudoDialog.UpdateWindKernel;
  764. BEGIN
  765.    DrawBorder;
  766.    IF fItems <> NIL THEN fItems.UpdateIt;
  767. END;
  768.  
  769. PROCEDURE TPseudoDialog.UpdateWindow;
  770. VAR   g  :  GrafPtr;
  771. BEGIN
  772.    GetPort(g);
  773.    SetPort(fWindow);
  774.    BeginUpdate(fWindow);
  775.    UpdateWindKernel;
  776.    EndUpdate(fWindow);
  777.    SetPort(g);
  778. END;
  779.  
  780. PROCEDURE TPseudoDialog.Idling;
  781. BEGIN
  782.    IF fItems <> NIL THEN fItems.Idle;
  783. END;
  784.  
  785. PROCEDURE TPseudoDialog.SetFont;
  786. VAR   g  :  GrafPtr;
  787. BEGIN
  788.    GetPort(g);
  789.    SetPort(fWindow);
  790.    fItems.SetItemFont;
  791.    SetPort(g);
  792. END;
  793.  
  794. FUNCTION TPseudoDialog.Keying
  795.          (c : CHAR;   modif : INTEGER) : LongInt;
  796. VAR   result  :  INTEGER;
  797. BEGIN
  798.    IF fItems = NIL
  799.       THEN Keying:= noItemHit
  800.       ELSE Keying:= fItems.KeyIt(c,modif);
  801. END;
  802.  
  803. FUNCTION TPseudoDialog.MouseInContent(p : Point;
  804.                        modif : INTEGER) : LongInt;
  805. BEGIN
  806.    MouseInContent:= noItemHit;   {Default}
  807.    IF fItems = NIL THEN Exit(MouseInContent);
  808.    CheckMultipleClicks(p);
  809.    GlobalToLocal(p);
  810.    MouseInContent:= fItems.Click(p,modif);
  811. END;
  812.  
  813. PROCEDURE TPseudoDialog.MouseInDrag(p : Point);
  814. BEGIN DragWindow(fWindow,p,dragArea); END;
  815. FUNCTION TPseudoDialog.HandleMouseEvents
  816.                (p : Point;
  817.             modif : INTEGER;
  818.           thePart : INTEGER) : LongInt;
  819. BEGIN
  820.    HandleMouseEvents:= noItemHit; {Default}
  821.    CASE thePart OF
  822.      inContent:IF fWindow <> FrontWindow
  823.                   THEN SelectWindow(fWindow)
  824.                   ELSE HandleMouseEvents:=
  825.                      MouseInContent(p,modif);
  826.         inDrag:MouseInDrag(p);
  827.    END;
  828. END;
  829.  
  830. PROCEDURE TPseudoDialog.RequestResponse
  831.           (theItem, theKind : INTEGER);
  832. BEGIN
  833.    IF fItems <> NIL THEN
  834.       fItems.Response(theItem,theKind);
  835. END;
  836.  
  837. {••••••••••••••••••••••••••••••••••••••••••••••••}
  838. { METHODS OF OBJECT TYPE “TPDialogItem”.         }
  839. {••••••••••••••••••••••••••••••••••••••••••••••••}
  840. PROCEDURE TPDialogItem.Free;
  841. BEGIN
  842.    IF fNexThing <> NIL THEN fNexThing.Free;
  843.    INHERITED Free;
  844. END;
  845.  
  846. PROCEDURE TPDialogItem.IPDialogItem(iBorder:Rect);
  847. BEGIN
  848.    fNexThing:= NIL;  fItsValue:= noItemHit;
  849.    { The above will be re-initialized
  850.      by “TPseudoDialog.InstallItem” }
  851.    fFlag[active] := FALSE;
  852.    fFlag[enable] := FALSE;
  853.    fFlag[animate]:= FALSE;
  854.    fBorder:= iBorder;
  855. END;
  856.  
  857. FUNCTION TPDialogItem.Information : Str255;
  858. BEGIN
  859.    Information:= '[Generic item]';
  860. END;
  861.  
  862. PROCEDURE TPDialogItem.EnableDisable
  863.           (index : INTEGER);
  864. BEGIN
  865.    IF index = fItsValue THEN BEGIN
  866.       fFlag[enable]:= NOT fFlag[enable];
  867.       Draw;
  868.    END
  869.    ELSE IF fNexThing <> NIL THEN
  870.       fNexThing.EnableDisable(index);
  871. END;
  872.  
  873. PROCEDURE TPDialogItem.AnimateIt;
  874. BEGIN
  875.    fFlag[animate]:= NOT fFlag[animate];
  876.    IF fNexThing <> NIL THEN fNexThing.AnimateIt;
  877. END;
  878.  
  879. PROCEDURE TPDialogItem.GetRectangle(VAR r : Rect);
  880. BEGIN r:= fBorder; END;
  881.  
  882. PROCEDURE TPDialogItem.Draw; {Dummy ancestor}
  883. BEGIN  SysBeep(1);  END;
  884.  
  885. { Method “UpdateIt” must be sandwiched
  886.   between “BeginUpdate” & “EndUpdate”.}
  887. PROCEDURE TPDialogItem.UpdateIt;
  888. BEGIN
  889.    Draw;
  890.    IF fNexThing <> NIL THEN fNexThing.UpdateIt;
  891. END;
  892.  
  893. PROCEDURE TPDialogItem.ActivateIt;
  894. BEGIN
  895.    IF fNexThing <> NIL THEN fNexThing.ActivateIt;
  896. END;
  897.  
  898. PROCEDURE TPDialogItem.DeactivateIt;
  899. BEGIN
  900.    IF fNexThing<>NIL THEN fNexThing.DeactivateIt;
  901. END;
  902.  
  903. PROCEDURE TPDialogItem.Idle;
  904. BEGIN
  905.    IF fNexThing <> NIL THEN fNexThing.Idle;
  906. END;
  907.  
  908. PROCEDURE TPDialogItem.SetItemFont;
  909. BEGIN
  910.    IF fNexThing <> NIL THEN fNexThing.SetItemFont;
  911. END;
  912.  
  913. FUNCTION TPDialogItem.Click
  914.          (p : Point;  modif : INTEGER) : LongInt;
  915. VAR   r  :  Rect;
  916. BEGIN
  917.    GetRectangle(r);
  918.    IF PtInRect(p,r) THEN BEGIN
  919.       IF fFlag[enable] THEN Click:= fItsValue
  920.                        ELSE Click:= noItemHit;
  921.    END
  922.    ELSE IF fNexThing = NIL THEN Click:= noItemHit
  923.    ELSE Click:= fNexThing.Click(p,modif);
  924. END;
  925.  
  926. { Method “KeyIt” is a function so we can return an
  927.   item number if appropriate for a particular key}
  928. FUNCTION TPDialogItem.KeyIt
  929.          (c : CHAR;  modif : INTEGER) : LongInt;
  930. BEGIN
  931.    IF fNexThing = NIL THEN KeyIt:= noItemHit
  932.    ELSE KeyIt:= fNexThing.KeyIt(c,modif);
  933. END;
  934.  
  935. PROCEDURE TPDialogItem.Response
  936.           (theItem,theKind : INTEGER);
  937. BEGIN
  938.    IF fNexThing <> NIL THEN
  939.       fNexThing.Response(theItem,theKind);
  940. END;
  941.  
  942. {••••••••••••••••••••••••••••••••••••••••••••••••}
  943. { METHODS OF OBJECT TYPE “TVerticalList”.        }
  944. {••••••••••••••••••••••••••••••••••••••••••••••••}
  945. PROCEDURE TVerticalList.Free;
  946. BEGIN
  947.    IF fData <> NIL THEN DisposHandle(fData);
  948.    INHERITED Free;
  949. END;
  950.  
  951. PROCEDURE TVerticalList.IVerticalList
  952.           (iBorder : Rect;  iPort : WindowPtr);
  953. BEGIN
  954.    IPDialogItem(iBorder);
  955.    fFlag[enable]:= TRUE;   {Override the default}
  956.    fLength:= 0;
  957.    fSelect:= 0;
  958.    fOffLin:= 0;
  959.    fOffByt:= 0;
  960.    fData  := NIL;
  961.    fFont  := forNowFI;
  962.    SetMeasures;
  963.    iBorder.left:= iBorder.right - scrWidth + 1;
  964.    InsetRect(iBorder,-1,-1);
  965.    fPort  := iPort;
  966.    fScroll:= NewControl(iPort,iBorder,'',FALSE,
  967.       0,0,scrBarMax,scrollBarProc,0);
  968.    InitKeyStuff;
  969. END;
  970.  
  971. FUNCTION TVerticalList.Information : Str255;
  972. VAR   s  :  Str255;
  973. BEGIN
  974.    s:= Concat('List, ',
  975.       IntString(fLength),' entries, ');
  976.    IF fSelect = 0 THEN
  977.       s:= Concat(s,'nothing selected, ')
  978.    ELSE s:= Concat(s,'#',
  979.       IntString(fSelect),' selected, ');
  980.    s:= Concat(s,IntString(fOffLin),
  981.       ' entries scrolled off top.');
  982.    Information:= s;
  983. END;
  984.  
  985. PROCEDURE TVerticalList.SetMeasures;
  986. VAR   f  :  FontIdent;
  987.       fm :  FMetricRec;
  988. BEGIN
  989.    f:= fFont;
  990.    SetFontIdent(f);
  991.    FontMetrics(fm);
  992.    WITH fm DO BEGIN
  993.       fHeight := FixRound(ascent+descent+leading);
  994.       fDescent:= FixRound(descent);
  995.    END;
  996. END;
  997.  
  998. PROCEDURE TVerticalList.GetRectangle(VAR r:Rect);
  999. BEGIN
  1000.    r:= fBorder;
  1001.    r.right:= r.right - scrWidth;
  1002. END;
  1003.  
  1004. FUNCTION TVerticalList.VisibleLines : INTEGER;
  1005. BEGIN
  1006.    VisibleLines:=
  1007.       (fBorder.bottom - fBorder.top) DIV fHeight;
  1008. END;
  1009.  
  1010. PROCEDURE TVerticalList.InstallData
  1011.           (theText : Handle);
  1012. VAR   x,lastOne,nextOne  :  LongInt;
  1013. BEGIN
  1014.    fLength:= 0;
  1015.    fSelect:= 0;
  1016.    fOffLin:= 0;
  1017.    fOffByt:= 0;
  1018.    IF fData <> NIL THEN DisposHandle(fData);
  1019.    fData:= theText;
  1020.    IF fData = NIL THEN Exit(InstallData);
  1021.    HLock(fData);
  1022.    x:= GetHandleSize(fData)-1; {Blank at end}
  1023.    nextOne:= 0;
  1024.    WHILE nextOne < x DO BEGIN
  1025.       lastOne:= nextOne + 1;
  1026.       nextOne:=
  1027.          Munger(fData,lastOne,blnkPtr,1,NIL,0);
  1028.       fLength:= fLength + 1;
  1029.       IF nextOne < 0 THEN nextOne:= x; {Error!}
  1030.    END;
  1031.    HUnLock(fData);
  1032.    Draw;
  1033. END;
  1034.  
  1035. PROCEDURE TVerticalList.DrawOneEntry(x,y:LongInt);
  1036. BEGIN
  1037.    y:= y - x;
  1038.    IF y > MaxInt THEN y:= MaxInt;
  1039.    DrawText(Ptr(ORD(fData^)+x),0,y);
  1040. END;
  1041.  
  1042. { “DrawEntries” just draws the entries, with
  1043.   port, clip & font maintenance done elsewhere. }
  1044. PROCEDURE TVerticalList.DrawEntries;
  1045. VAR   i,lastOne,nextOne,y  :  LongInt;
  1046.       x  :  INTEGER;
  1047.    PROCEDURE ExitDE;
  1048.    BEGIN HUnLock(fData); Exit(DrawEntries); END;
  1049. BEGIN
  1050.    i:= fOffLin;
  1051.    x:= fBorder.left + textMarge;
  1052.    nextOne:= fOffByt;
  1053.    HLock(fData);
  1054.    WHILE i < fLength DO BEGIN
  1055.       i:= i + 1;
  1056.       lastOne:= nextOne + 1;
  1057.       nextOne:=
  1058.          Munger(fData,lastOne,blnkPtr,1,NIL,0);
  1059.       IF nextOne < 0 THEN ExitDE; {Error!}
  1060.       IF i > fOffLin THEN BEGIN
  1061.          y:= fBorder.top + (i-fOffLin)*fHeight;
  1062.          IF y > fBorder.bottom  THEN ExitDE;
  1063.          MoveTo(x,y-fDescent);
  1064.          DrawOneEntry(lastOne,nextOne);
  1065.       END;
  1066.    END;
  1067.    ExitDE;
  1068. END;
  1069.  
  1070. FUNCTION TVerticalList.GetSelection : Str63;
  1071. VAR   s  :  Str63;
  1072.       i  :  INTEGER;
  1073.       x,lastOne,nextOne  :  LongInt;
  1074.    PROCEDURE ExitGS;
  1075.    BEGIN
  1076.       HUnLock(fData);
  1077.       GetSelection:= s;
  1078.       Exit(GetSelection);
  1079.    END;
  1080. BEGIN
  1081.    s:= '';
  1082.    x:= fOffLin;
  1083.    nextOne:= fOffByt;
  1084.    HLock(fData);
  1085.    WHILE x < fSelect DO BEGIN
  1086.       x:= x + 1;
  1087.       lastOne:= nextOne + 1;
  1088.       nextOne:=
  1089.          Munger(fData,lastOne,blnkPtr,1,NIL,0);
  1090.       IF nextOne < 0 THEN ExitGS; {Error!}
  1091.    END;
  1092.    i:= nextOne - lastOne;
  1093.    IF i > 63 THEN i:= 63;
  1094.    BlockMove(Ptr(ORD(fData^)+lastOne),
  1095.       Ptr(ORD(@s)+1),i);
  1096.    s[0]:= CHR(i);
  1097.    ExitGS;
  1098. END;
  1099.  
  1100. PROCEDURE TVerticalList.SelectionRectangle
  1101.           (VAR r : Rect);
  1102. VAR   i  :  LongInt;
  1103.    PROCEDURE SelectionNotVisible;
  1104.    BEGIN
  1105.       SetRect(r,0,0,0,0);
  1106.       Exit(SelectionRectangle);
  1107.    END;
  1108. BEGIN
  1109.    i:= fSelect - fOffLin;
  1110.    IF i <= 0 THEN SelectionNotVisible;
  1111.    GetRectangle(r);
  1112.    i:= r.top + i*fHeight;
  1113.    IF i > r.bottom THEN SelectionNotVisible;
  1114.    r.bottom:= i;
  1115.    r.top:= i - fHeight;
  1116. END;
  1117.  
  1118. PROCEDURE TVerticalList.HiliteSelection;
  1119. VAR   r  :  Rect;
  1120. BEGIN
  1121.    SelectionRectangle(r);
  1122.    IF EqualPt(r.topLeft,r.botRight) THEN
  1123.       Exit(HiliteSelection);
  1124.    BitClr(Ptr(hiliteMode),pHiliteBit);
  1125.    IF fFlag[active] THEN InvertRect(r)
  1126.    ELSE BEGIN
  1127.       PenSize(2,2);
  1128.       FrameRect(r);
  1129.       PenNormal;
  1130.    END;
  1131. END;
  1132.  
  1133. PROCEDURE TVerticalList.ActivationSel
  1134.           (activate : BOOLEAN);
  1135. VAR   r  :  Rect;
  1136. BEGIN
  1137.    IF fFlag[active] = activate THEN
  1138.       Exit(ActivationSel);
  1139.    fFlag[active]:= activate;
  1140.    SelectionRectangle(r);
  1141.    IF EqualPt(r.topLeft,r.botRight) THEN
  1142.       Exit(ActivationSel);
  1143.    InsetRect(r,2,2);
  1144.    MyInvertRect(r);
  1145. END;
  1146.  
  1147. PROCEDURE TVerticalList.DrawEntsAndSel;
  1148. VAR   r  :  Rect;
  1149. BEGIN
  1150.    GetRectangle(r);
  1151.    ClipRect(r);
  1152.    EraseRect(r);
  1153.    IF fData <> NIL THEN BEGIN
  1154.       DrawEntries;
  1155.       HiliteSelection;
  1156.    END;
  1157.    RestoreClip;
  1158. END;
  1159.  
  1160. PROCEDURE TVerticalList.DrawBorder;
  1161. VAR   r  :  Rect;
  1162. BEGIN
  1163.    GetRectangle(r);
  1164.    InsetRect(r,-1,-1);
  1165.    FrameRect(r);
  1166. END;
  1167.  
  1168. PROCEDURE TVerticalList.Draw;
  1169. VAR   r  :  Rect;
  1170.       f  :  FontIdent;
  1171. BEGIN
  1172.    f:= fFont;
  1173.    SetFontIdent(f);
  1174.    DrawBorder;
  1175.    DrawEntsAndSel;
  1176.    Draw1Control(fScroll);
  1177. END;
  1178.  
  1179. PROCEDURE TVerticalList.ActivateIt;
  1180. BEGIN
  1181.    ActivationSel(TRUE);
  1182.    ShowControl(fScroll);
  1183.    INHERITED ActivateIt;
  1184. END;
  1185.  
  1186. PROCEDURE TVerticalList.DeactivateIt;
  1187. VAR   r  :  Rect;
  1188. BEGIN
  1189.    ActivationSel(FALSE);
  1190.    HideControl(fScroll);
  1191.    DrawBorder;
  1192.    INHERITED DeactivateIt;
  1193. END;
  1194.  
  1195. PROCEDURE TVerticalList.SetItemFont;
  1196. BEGIN
  1197.    fFont:= forNowFI;
  1198.    SetMeasures;
  1199.    Draw;
  1200.    INHERITED SetItemFont;
  1201. END;
  1202.  
  1203. PROCEDURE TVerticalList.CheckScrollability;
  1204. VAR   vis  :  INTEGER;
  1205. BEGIN
  1206.    IF fData = NIL THEN
  1207.       HiliteControl(fScroll,scrBarHide)
  1208.    ELSE IF fOffLin > 0 THEN
  1209.       HiliteControl(fScroll,scrBarShow)
  1210.    ELSE BEGIN
  1211.       vis:= VisibleLines;
  1212.       HiliteControl(fScroll,
  1213.          ScrollBarShowHide(fLength > vis));
  1214.    END;
  1215. END;
  1216.  
  1217. PROCEDURE TVerticalList.SetScrollValue;
  1218. VAR   max,
  1219.       min,
  1220.       vis  :  INTEGER;
  1221.       ratio  :  Fract;
  1222. BEGIN
  1223.    min:= GetCtlMin(fScroll);
  1224.    max:= GetCtlMax(fScroll);
  1225.    vis:= VisibleLines;
  1226.    IF fLength <= vis THEN SetCtlValue(fScroll,min)
  1227.    ELSE BEGIN
  1228.       ratio:= FracDiv(fOffLin, fLength-vis);
  1229.       SetCtlValue(fScroll,FracMul(ratio,max-min));
  1230.    END;
  1231. END;
  1232.  
  1233. PROCEDURE TVerticalList.OneLineLess;
  1234. VAR   r  :  Rect;
  1235.       rgn  :  RgnHandle;
  1236.    PROCEDURE DrawFirstLine;
  1237.    VAR   i  :  LongInt;
  1238.          c  :  Str1;
  1239.    BEGIN
  1240.       i:= fOffByt;
  1241.       REPEAT
  1242.          i:= i - 1;
  1243.          IF i < 0 THEN Exit(DrawFirstLine);
  1244.          BlockMove(Ptr(ORD(fData^)+i),@c,1);
  1245.       UNTIL c[0] = blnkChr;
  1246.       MoveTo(r.left+textMarge,
  1247.              r.top+fHeight-fDescent);
  1248.       DrawOneEntry(i+1,fOffByt);
  1249.       IF fSelect = fOffLin THEN BEGIN
  1250.          r.bottom:= r.top + fHeight;
  1251.          MyInvertRect(r);
  1252.       END;
  1253.       fOffLin:= fOffLin - 1;
  1254.       fOffByt:= i;
  1255.    END;
  1256.    PROCEDURE EraseLastLine;
  1257.    VAR   saveTop  :  INTEGER;
  1258.    BEGIN
  1259.       saveTop:= r.top;
  1260.       r.top:= r.top + VisibleLines*fHeight;
  1261.       EraseRect(r);
  1262.       r.top:= saveTop;
  1263.    END;
  1264. BEGIN
  1265.    IF fOffLin <= 0 THEN Exit(OneLineLess);
  1266.    GetRectangle(r);
  1267.    ClipRect(r);
  1268.    rgn:= NewRgn;
  1269.    ScrollRect(r,0,fHeight,rgn);
  1270.    EraseLastLine;
  1271.    DisposeRgn(rgn);
  1272.    HLock(fData);
  1273.    DrawFirstLine;
  1274.    HUnLock(fData);
  1275.    RestoreClip;
  1276. END;
  1277.  
  1278. PROCEDURE TVerticalList.OneLineMore;
  1279. VAR   r  :  Rect;
  1280.       rgn  :  RgnHandle;
  1281.       vis  :  INTEGER;
  1282.    PROCEDURE DrawLastLine;
  1283.    VAR   thisLine,
  1284.          lastLine,
  1285.          lastOne,
  1286.          nextOne  :  LongInt;
  1287.    BEGIN
  1288.       fOffLin:= fOffLin + 1;
  1289.       fOffByt:=
  1290.          Munger(fData,fOffByt+1,blnkPtr,1,NIL,0);
  1291.       IF nextOne < 0 THEN Exit(DrawLastLine);
  1292.  
  1293.       thisLine:= fOffLin;
  1294.       lastLine:= fOffLin + vis;
  1295.       nextOne:= fOffByt;
  1296.       WHILE thisLine < lastLine DO BEGIN
  1297.          thisLine:= thisLine + 1;
  1298.          lastOne:= nextOne + 1;
  1299.          nextOne:=
  1300.             Munger(fData,lastOne,blnkPtr,1,NIL,0);
  1301.          IF nextOne < 0 THEN Exit(DrawLastLine);
  1302.       END;
  1303.       r.bottom:= r.top + vis*fHeight;
  1304.       MoveTo(r.left+textMarge, r.bottom-fDescent);
  1305.       DrawOneEntry(lastOne,nextOne);
  1306.       IF fSelect = lastLine THEN BEGIN
  1307.          r.top:= r.bottom - fHeight;
  1308.          MyInvertRect(r);
  1309.       END;
  1310.    END;
  1311. BEGIN
  1312.    vis:= VisibleLines;
  1313.    IF fOffLin>=fLength-vis THEN Exit(OneLineMore);
  1314.    GetRectangle(r);
  1315.    ClipRect(r);
  1316.    rgn:= NewRgn;
  1317.    ScrollRect(r,0,-fHeight,rgn);
  1318.    DisposeRgn(rgn);
  1319.    HLock(fData);
  1320.    DrawLastLine;
  1321.    HUnLock(fData);
  1322.    RestoreClip;
  1323. END;
  1324.  
  1325. { “RecalOffByte” recalculates "fOffByt". }
  1326. PROCEDURE TVerticalList.RecalOffByte;
  1327. VAR   i,lastOne  :  LongInt;
  1328.  
  1329.    PROCEDURE ExitROB;
  1330.    BEGIN HUnLock(fData); Exit(RecalOffByte); END;
  1331. BEGIN
  1332.    SetCursor(waitCursor^^);
  1333.    i:= 0;
  1334.    fOffByt:= 0;
  1335.    HLock(fData);
  1336.    WHILE i < fOffLin DO BEGIN
  1337.       i:= i + 1;
  1338.       lastOne:= fOffByt + 1;
  1339.       fOffByt:=
  1340.          Munger(fData,lastOne,blnkPtr,1,NIL,0);
  1341.       IF fOffByt < 0 THEN BEGIN
  1342.          fOffLin:= 0;
  1343.          fOffByt:= 0;
  1344.          ExitROB;
  1345.       END;
  1346.    END;
  1347.    ExitROB;
  1348. END;
  1349.  
  1350. PROCEDURE TVerticalList.OnePageLess;
  1351. VAR   newOffLine  :  LongInt;
  1352.       c  :  Str1;
  1353. BEGIN
  1354.    IF fOffLin <= 0 THEN Exit(OnePageLess);
  1355.    newOffLine:= fOffLin - (VisibleLines-1);
  1356.    IF newOffLine <= 0 THEN BEGIN
  1357.       fOffLin:= 0;
  1358.       fOffByt:= 0;
  1359.    END
  1360.    ELSE WHILE fOffLin > newOffLine DO BEGIN
  1361.       fOffLin:= fOffLin - 1;
  1362.       REPEAT
  1363.          fOffByt:= fOffByt - 1;
  1364.          BlockMove(Ptr(ORD(fData^)+fOffByt),@c,1);
  1365.       UNTIL c[0] = blnkChr;
  1366.    END;
  1367.    DrawEntsAndSel;
  1368. END;
  1369.  
  1370. PROCEDURE TVerticalList.OnePageMore;
  1371. VAR   vis  :  INTEGER;
  1372.       max,
  1373.       newOffLine  :  LongInt;
  1374. BEGIN
  1375.    vis:= VisibleLines;
  1376.    max:= fLength - vis;
  1377.    IF fOffLin >= max THEN Exit(OnePageMore);
  1378.    newOffLine:= fOffLin + (vis-1);
  1379.    IF newOffLine > max THEN newOffLine:= max;
  1380.    WHILE fOffLin < newOffLine DO BEGIN
  1381.       fOffLin:= fOffLin + 1;
  1382.       fOffByt:=
  1383.          Munger(fData,fOffByt+1,blnkPtr,1,NIL,0);
  1384.    END;
  1385.    DrawEntsAndSel;
  1386. END;
  1387.  
  1388. PROCEDURE TVerticalList.Thumbing(p : Point);
  1389. VAR   min,
  1390.       apres  :  INTEGER;
  1391.       vis,
  1392.       avant  :  LongInt;
  1393.       ratio  :  Fract;
  1394. BEGIN
  1395.    min:= GetCtlMin(fScroll);
  1396.    avant:= GetCtlValue(fScroll);
  1397.    apres:= TrackControl(fScroll,p,NIL);
  1398.    apres:= GetCtlValue(fScroll);
  1399.    IF apres <> avant THEN BEGIN
  1400.       vis:= VisibleLines;
  1401.       IF fLength <= vis THEN
  1402.          SetCtlValue(fScroll,min)
  1403.       ELSE BEGIN
  1404.          avant:= fOffLin;
  1405.          ratio:= FracDiv(apres-min,
  1406.             GetCtlMax(fScroll)-min);
  1407.          vis:= fLength - vis;
  1408.          fOffLin:= FracMul(ratio,vis);
  1409.          IF fOffLin < 0 THEN fOffLin:= 0
  1410.          ELSE IF fOffLin > vis THEN fOffLin:= vis;
  1411.          IF fOffLin <> avant THEN BEGIN
  1412.             RecalOffByte;
  1413.             CheckScrollability;
  1414.             DrawEntsAndSel;
  1415.          END;
  1416.       END;
  1417.    END;
  1418. END;
  1419.  
  1420. PROCEDURE TVerticalList.Scrolling(part : INTEGER);
  1421. VAR   x  :  LongInt;
  1422.       r  :  Rect;
  1423. BEGIN
  1424.    CASE part OF
  1425.       inUpButton:
  1426.          BEGIN
  1427.             HiliteControl(fScroll,part);
  1428.             WHILE StillDown DO BEGIN
  1429.                Delay(vertListDelay,x);
  1430.                OneLineLess;
  1431.                SetScrollValue;
  1432.             END;
  1433.             HiliteControl(fScroll,toggleOff);
  1434.          END;
  1435.       inDownButton:
  1436.          BEGIN
  1437.             HiliteControl(fScroll,part);
  1438.             WHILE StillDown DO BEGIN
  1439.                Delay(vertListDelay,x);
  1440.                OneLineMore;
  1441.                SetScrollValue;
  1442.             END;
  1443.             HiliteControl(fScroll,toggleOff);
  1444.             GetRectangle(r);
  1445.             r.top:= r.top + VisibleLines*fHeight;
  1446.             InvalRect(r);
  1447.          END;
  1448.       inPageUp:
  1449.          WHILE StillDown DO BEGIN
  1450.             Delay(vertListDelay,x);
  1451.             OnePageLess;
  1452.             SetScrollValue;
  1453.          END;
  1454.       inPageDown:
  1455.          WHILE StillDown DO BEGIN
  1456.             Delay(vertListDelay,x);
  1457.             OnePageMore;
  1458.             SetScrollValue;
  1459.          END;
  1460.    END;
  1461.    CheckScrollability;
  1462. END;
  1463.  
  1464. PROCEDURE TVerticalList.DragSelecting;
  1465. VAR   r  :  Rect;
  1466.       p  :  Point;
  1467.       vis  :  INTEGER;
  1468.       lineHit  :  LongInt;
  1469. BEGIN
  1470.    GetRectangle(r);
  1471.    vis:= (r.bottom - r.top) DIV fHeight;
  1472.    REPEAT
  1473.       GetMouse(p);
  1474.       IF PtInRect(p,r) THEN BEGIN
  1475.          lineHit:=
  1476.             fOffLin + (p.v-r.top) DIV fHeight + 1;
  1477.          SetSelection(lineHit);
  1478.       END
  1479.       ELSE IF p.v < r.top THEN BEGIN
  1480.          OneLineLess;
  1481.          SetScrollValue;
  1482.          SetSelection(fOffLin+1);
  1483.       END
  1484.       ELSE IF p.v > r.bottom THEN BEGIN
  1485.          OneLineMore;
  1486.          SetScrollValue;
  1487.          SetSelection(fOffLin+vis);
  1488.       END;
  1489.    UNTIL NOT StillDown;
  1490. END;
  1491.  
  1492. FUNCTION TVerticalList.Click
  1493.          (p : Point;  modif : INTEGER) : LongInt;
  1494. VAR   r  :  Rect;
  1495.       f  :  FontIdent;
  1496.       c  :  ControlHandle;
  1497.       part  :  INTEGER;
  1498.    PROCEDURE ClickInEntries;
  1499.    VAR   i  :  INTEGER;
  1500.          lineHit  :  LongInt;
  1501.    BEGIN
  1502.       SetFontIdent(f);
  1503.       Click:= fItsValue;
  1504.       i:= (p.v - r.top) DIV fHeight + 1;
  1505.       lineHit:= fOffLin + i;
  1506.       IF BAnd(modif,shiftKey) = 0 THEN BEGIN
  1507.          SetSelection(lineHit);
  1508.          IF dublClick THEN BEGIN
  1509.             GetMouse(p);
  1510.             r.bottom:= r.top + i*fHeight;
  1511.             r.top   := r.bottom - fHeight;
  1512.             IF PtInRect(p,r) THEN Click:=
  1513.                MakeLongInt(fItsValue,doubleClick);
  1514.          END
  1515.          ELSE IF StillDown THEN DragSelecting;
  1516.       END
  1517.       { Below, shift-clicking }
  1518.       ELSE IF fSelect=lineHit THEN CancelSelection
  1519.       ELSE SetSelection(lineHit);
  1520.    END;
  1521. BEGIN
  1522.    GetRectangle(r);
  1523.    part:= FindControl(p,fPort,c);
  1524.    f:= fFont;
  1525.    IF c = fScroll THEN BEGIN
  1526.       SetFontIdent(f);
  1527.       Click:= fItsValue;
  1528.       IF part = inThumb THEN Thumbing(p)
  1529.                         ELSE Scrolling(part);
  1530.    END
  1531.    ELSE IF PtInRect(p,r) THEN ClickInEntries
  1532.    ELSE IF fNexThing = NIL THEN Click:= noItemHit
  1533.    ELSE Click:= fNexThing.Click(p,modif);
  1534. END;
  1535.  
  1536. PROCEDURE TVerticalList.CancelSelection;
  1537. BEGIN
  1538.    IF fSelect = 0 THEN Exit(CancelSelection);
  1539.    HiliteSelection;
  1540.    fSelect:= 0;
  1541. END;
  1542.  
  1543. PROCEDURE TVerticalList.SetSelection
  1544.           (newSel : LongInt);
  1545. VAR   i  :  LongInt;
  1546.       g  :  GrafPtr;
  1547. BEGIN
  1548.    IF newSel = fSelect THEN Exit(SetSelection);
  1549.    GetPort(g);
  1550.    SetPort(fPort);
  1551.    CancelSelection;
  1552.    IF (newSel>=0) AND (newSel<=fLength) THEN BEGIN
  1553.       fSelect:= newSel;
  1554.       HiliteSelection;
  1555.    END;
  1556.    SetPort(g);
  1557. END;
  1558.  
  1559. PROCEDURE TVerticalList.ShowSelection;
  1560. VAR   i  :  LongInt;
  1561.       v  :  INTEGER;
  1562. BEGIN
  1563.    IF fSelect = 0 THEN Exit(ShowSelection);
  1564.    i:= fSelect - fOffLin;
  1565.    v:= VisibleLines;
  1566.    IF (i>0) AND (i<=v) THEN Exit(ShowSelection);
  1567.    v:= v DIV 2;      {Centre vertically}
  1568.    IF v = 0 THEN v:= 1;
  1569.    fOffLin:= fSelect - v;
  1570.    IF fOffLin < 0 THEN fOffLin:= 0;
  1571.    RecalOffByte;
  1572.    SetScrollValue;
  1573.    Draw;
  1574. END;
  1575.  
  1576. PROCEDURE TVerticalList.InitKeyStuff;
  1577. BEGIN
  1578.    fUserHitKeys:= '';
  1579.    fLastKeyTime:= 0;
  1580. END;
  1581.  
  1582. PROCEDURE TVerticalList.SelectCellStart(c : CHAR);
  1583. VAR   sUser  :  StrListKey;
  1584.       iUser  :  INTEGER;
  1585.    FUNCTION NewKeyString : BOOLEAN;
  1586.    VAR   x  :  LongInt;
  1587.    BEGIN
  1588.       x:= TickCount;
  1589.       iUser:= Length(sUser);
  1590.       IF iUser = 0 THEN NewKeyString:= TRUE
  1591.       ELSE IF iUser = listKeyLeng THEN
  1592.          NewKeyString:= TRUE
  1593.       ELSE NewKeyString:=
  1594.          (x - fLastKeyTime > GetDblTime);
  1595.       fLastKeyTime:= x;
  1596.    END;
  1597.    PROCEDURE ScanForMatch;
  1598.    VAR   sList  :  StrListKey;
  1599.          iList,     {Use a LongInt to be safe}
  1600.          i,
  1601.          lastOne,
  1602.          nextOne,
  1603.          timeHere  :  LongInt;
  1604.       PROCEDURE ExitSCS;
  1605.       BEGIN
  1606.          HUnLock(fData);
  1607.          {Compensate for time spent here}
  1608.          fLastKeyTime:=
  1609.             fLastKeyTime + (TickCount-timeHere);
  1610.          Exit(SelectCellStart);
  1611.       END;
  1612.    BEGIN
  1613.       timeHere:= TickCount;
  1614.       SetCursor(waitCursor^^);
  1615.       i:= fOffLin; nextOne:= fOffByt; {From top}
  1616.       HLock(fData);
  1617.       WHILE i < fLength DO BEGIN
  1618.          i:= i + 1;
  1619.          lastOne:= nextOne + 1;
  1620.          nextOne:=
  1621.             Munger(fData,lastOne,blnkPtr,1,NIL,0);
  1622.          IF nextOne < 0 THEN ExitSCS;     {Error!}
  1623.          iList:= nextOne - lastOne;
  1624.          IF iList > iUser THEN iList:= iUser;
  1625.          BlockMove(Ptr(ORD(fData^)+lastOne),
  1626.             Ptr(ORD(@sList)+1),iList);
  1627.          sList[0]:= CHR(iList);
  1628.          IF IUEqualString(sList,sUser) = 0 THEN
  1629.          BEGIN
  1630.             SetSelection(i);
  1631.             ShowSelection;
  1632.             ExitSCS;
  1633.          END;
  1634.       END;
  1635.       ExitSCS;
  1636.    END;
  1637. BEGIN
  1638.    CancelSelection;
  1639.    sUser:= fUserHitKeys;
  1640.    IF NewKeyString THEN sUser:= MakeStr1(c)
  1641.    ELSE sUser:= Concat(sUser,MakeStr1(c));
  1642.    iUser:= Length(sUser);
  1643.    fUserHitKeys:= sUser;
  1644.    ScanForMatch;
  1645. END;
  1646.  
  1647. FUNCTION TVerticalList.KeyIt
  1648.          (c : CHAR;  modif : INTEGER) : LongInt;
  1649. BEGIN
  1650.    IF c IN [left,right,up,down] THEN BEGIN
  1651.       KeyIt:= fItsValue;
  1652.       IF      c= up  THEN SetSelection(fSelect-1)
  1653.       ELSE IF c=down THEN SetSelection(fSelect+1);
  1654.       ShowSelection;
  1655.    END
  1656.    ELSE IF c IN [entr,cRet] THEN BEGIN
  1657.       ShowSelection;
  1658.       KeyIt:= MakeLongInt(fItsValue,doubleClick);
  1659.    END
  1660.    ELSE IF BAnd(modif,cmdKey) <> 0 THEN
  1661.       KeyIt:= INHERITED KeyIt(c,modif)
  1662.    ELSE IF c >= blnkChr THEN BEGIN
  1663.       KeyIt:= fItsValue;
  1664.       SelectCellStart(c);
  1665.    END
  1666.    ELSE KeyIt:= INHERITED KeyIt(c,modif);
  1667. END;
  1668.  
  1669. PROCEDURE TVerticalList.Response
  1670.           (theItem,theKind : INTEGER);
  1671. VAR   s  :  Str255;
  1672. BEGIN
  1673.    IF theItem <> fItsValue THEN
  1674.       INHERITED Response(theItem,theKind)
  1675.    ELSE IF theKind = doubleClick THEN BEGIN
  1676.       IF (fSelect<fOffLin) OR (fSelect<=0) THEN
  1677.          SysBeep(1)
  1678.       ELSE BEGIN
  1679.          s:= GetSelection;
  1680.          s:= Concat('Entry #',
  1681.             IntString(fSelect),' is:',cRet,s);
  1682.          SetDAFont(fFont.n);
  1683.          SimpleAlert(s);
  1684.          SetDAFont(systemFont);
  1685.       END;
  1686.    END;
  1687. END;
  1688.  
  1689. PROCEDURE TVerticalList.Resize(hauteur : INTEGER);
  1690. VAR   r  :  Rect;
  1691.       g  :  GrafPtr;
  1692. BEGIN
  1693.    r:= fBorder;
  1694.    fBorder.bottom:= fBorder.top + hauteur;
  1695.    IF fBorder.bottom > r.bottom THEN BEGIN
  1696.       GetPort(g);
  1697.       SetPort(fPort);
  1698.       r.top:= r.bottom;
  1699.       r.bottom:= fBorder.bottom;
  1700.       InvalRect(r);
  1701.       SetPort(g);
  1702.    END;
  1703.    SizeControl(fScroll,scrWidth+1,hauteur+2);
  1704.    CheckScrollability;
  1705. END;
  1706.  
  1707. {••••••••••••••••••••••••••••••••••••••••••••••••}
  1708. { METHODS OF OBJECT TYPE “TPlainButton”.         }
  1709. {••••••••••••••••••••••••••••••••••••••••••••••••}
  1710. PROCEDURE TPlainButton.IPlainButton
  1711.           (iBorder : Rect;  iTitle : Str15;
  1712.            iEquiv : CHAR;    iFont : FontIdent);
  1713. VAR   f  :  FontIdent;
  1714.       x  :  INTEGER;
  1715.       info  :  FontInfo;
  1716. BEGIN
  1717.    IPDialogItem(iBorder);
  1718.    fFlag[enable]:= TRUE;   {Override the default}
  1719.    fTitle:= iTitle;
  1720.    fEquiv[1]:= iEquiv;
  1721.    IF iEquiv IN ['A'..'Z'] THEN
  1722.       iEquiv:= CHR(ORD(iEquiv)+32)
  1723.    ELSE IF iEquiv IN ['a'..'z'] THEN
  1724.       iEquiv:= CHR(ORD(iEquiv)-32);
  1725.    fEquiv[2]:= iEquiv;
  1726.    fFont:= iFont;
  1727.    {If border’s height is zero, then calculate it}
  1728.    IF fBorder.top = fBorder.bottom THEN BEGIN
  1729.       GetFontIdent(f);
  1730.       SetFontIdent(iFont);
  1731.       GetFontInfo(info);
  1732.       WITH info DO x:= ascent + descent + leading;
  1733.       IF x < minBtnHeight THEN x:= minBtnHeight;
  1734.       fBorder.bottom:= fBorder.top+x+ExtraHeight;
  1735.       SetFontIdent(f);
  1736.    END;
  1737. END;
  1738.  
  1739. FUNCTION TPlainButton.KeyInfo : Str15;
  1740. VAR   s  :  Str15;
  1741. BEGIN
  1742.    s:= ' {';
  1743.    IF fEquiv[1] = null
  1744.       THEN s:= Concat(s,'null')
  1745.       ELSE s:= Concat(s,fEquiv[1]);
  1746.    IF fEquiv[2] = null
  1747.       THEN s:= Concat(s,', null')
  1748.       ELSE s:= Concat(s,', ',fEquiv[2]);
  1749.    KeyInfo:= Concat(s,'}');
  1750. END;
  1751.  
  1752. FUNCTION TPlainButton.ButtonInfo : Str255;
  1753. BEGIN  ButtonInfo:= 'Plain button';  END;
  1754.  
  1755. FUNCTION TPlainButton.Information : Str255;
  1756. BEGIN
  1757.    Information:= Concat(ButtonInfo,KeyInfo);
  1758. END;
  1759.  
  1760. FUNCTION TPlainButton.ExtraHeight : INTEGER;
  1761. BEGIN  ExtraHeight:= 2; END;
  1762. PROCEDURE TPlainButton.DrawTitle(r : Rect);
  1763. CONST commandChar = CHR(17);
  1764. VAR   s  :  Str15;
  1765.       p  :  Point;
  1766.       info  :  FontInfo;
  1767.       saveFont,textFont  :  FontIdent;
  1768. BEGIN
  1769.    GetFontIdent(saveFont);
  1770.    textFont:= fFont;
  1771.    SetFontIdent(textFont);
  1772.    s:= fTitle;
  1773.    GetFontInfo(info);
  1774.    p.h:= (r.left+r.right-StringWidth(s)) DIV 2;
  1775.    p.v:= info.descent;
  1776.    IF p.v < minBtnDescent THEN p.v:=minBtnDescent;
  1777.    p.v:= r.bottom - p.v;
  1778.    MoveTo(p.h,p.v);
  1779.    DrawString(s);
  1780.    IF fEquiv[1] <> null THEN BEGIN
  1781.       SetFontSizeFace(systemFont,12,[condense]);
  1782.       s:= Concat(commandChar,fEquiv[1]);
  1783.       p.h:= r.right - StringWidth(s) - 2;
  1784.       MoveTo(p.h,p.v);
  1785.       DrawString(s);
  1786.    END;
  1787.    SetFontIdent(saveFont);
  1788.    IF NOT (fFlag[active] AND fFlag[enable]) THEN
  1789.    BEGIN
  1790.       PenPat(gray);
  1791.       PenMode(patBic);
  1792.       PaintRect(r);
  1793.       PenNormal;
  1794.    END;
  1795. END;
  1796.  
  1797. PROCEDURE TPlainButton.Draw;
  1798. VAR   r  :  Rect;
  1799. BEGIN
  1800.    GetRectangle(r);
  1801.    InsetRect(r,-1,-1);
  1802.    EraseRect(r);
  1803.    FrameRoundRect(r,ovalSize,ovalSize);
  1804.    InsetRect(r,1+ovalSize,1);
  1805.    DrawTitle(r);
  1806. END;
  1807.  
  1808. PROCEDURE TPlainButton.ActivateIt;
  1809. BEGIN
  1810.    fFlag[active]:= TRUE;
  1811.    Draw;
  1812.    INHERITED ActivateIt;
  1813. END;
  1814.  
  1815. PROCEDURE TPlainButton.DeactivateIt;
  1816. VAR   r  :  Rect;
  1817. BEGIN
  1818.    fFlag[active]:= FALSE;
  1819.    Draw;
  1820.    INHERITED DeactivateIt;
  1821. END;
  1822.  
  1823. FUNCTION TPlainButton.Click
  1824.          (p : Point;  modif : INTEGER) : LongInt;
  1825. VAR   r  :  Rect;
  1826. BEGIN
  1827.    GetRectangle(r);
  1828.    IF PtInRect(p,r) THEN BEGIN
  1829.       IF NOT (fFlag[active] AND fFlag[enable])THEN
  1830.          Click:= noItemHit
  1831.       ELSE IF MouseReleasedHere THEN
  1832.          Click:= fItsValue
  1833.       ELSE Click:= noItemHit;
  1834.    END
  1835.    ELSE IF fNexThing = NIL THEN Click:= noItemHit
  1836.    ELSE Click:= fNexThing.Click(p,modif);
  1837. END;
  1838.  
  1839. PROCEDURE TPlainButton.Invert(r : Rect);
  1840. BEGIN
  1841.    BitClr(Ptr(hiliteMode),pHiliteBit);
  1842.    InvertRoundRect(r,ovalSize,ovalSize);
  1843. END;
  1844.  
  1845. { “MouseReleasedHere” tracks mouse in button.}
  1846. FUNCTION TPlainButton.MouseReleasedHere : BOOLEAN;
  1847. VAR   p  :  Point;
  1848.       r  :  Rect;
  1849.       inside  :  MouseFlags;
  1850. BEGIN
  1851.    GetRectangle(r);
  1852.    inside[before]:= TRUE;
  1853.    InsetRect(r,1,1);
  1854.    Invert(r);
  1855.    REPEAT
  1856.       GetMouse(p);
  1857.       inside[now]:= PtInRect(p,r);
  1858.       IF inside[now] <> inside[before] THEN BEGIN
  1859.          Invert(r);
  1860.          inside[before]:= inside[now];
  1861.       END;
  1862.    UNTIL NOT StillDown;
  1863.    MouseReleasedHere:= inside[now];
  1864.    IF inside[now] THEN Invert(r);
  1865. END;
  1866.  
  1867. { “VisualFeedback” is used by “KeyIt” to
  1868.   simulate a hit in the button. Somewhat
  1869.   similar to “MouseReleasedHere”. }
  1870. PROCEDURE TPlainButton.VisualFeedback;
  1871. VAR   r  :  Rect;
  1872.       x  :  LongInt;
  1873. BEGIN
  1874.    GetRectangle(r);
  1875.    InsetRect(r,1,1);
  1876.    Invert(r);
  1877.    Delay(feedbackDelay,x);
  1878.    Invert(r);
  1879. END;
  1880.  
  1881. FUNCTION TPlainButton.KeyIt
  1882.          (c : CHAR;  modif : INTEGER) : LongInt;
  1883. BEGIN
  1884.    IF c = null THEN
  1885.       KeyIt:= INHERITED KeyIt(c,modif)
  1886.    ELSE IF BAnd(modif,cmdKey) = 0 THEN
  1887.       KeyIt:= INHERITED KeyIt(c,modif)
  1888.    ELSE IF (c = fEquiv[1]) OR (c = fEquiv[2]) THEN
  1889.    BEGIN
  1890.       VisualFeedback;
  1891.       KeyIt:= fItsValue;
  1892.    END
  1893.    ELSE KeyIt:= INHERITED KeyIt(c,modif);
  1894. END;
  1895.  
  1896. {••••••••••••••••••••••••••••••••••••••••••••••••}
  1897. { METHODS OF OBJECT TYPE “TToggleButton”.        }
  1898. {••••••••••••••••••••••••••••••••••••••••••••••••}
  1899. PROCEDURE TToggleButton.IToggleButton
  1900.           (iBorder : Rect;  iTitle : Str15;
  1901.             iEquiv : CHAR;   iFont : FontIdent;
  1902.            iStatus : INTEGER);
  1903. BEGIN
  1904.    IPlainButton(iBorder,iTitle,iEquiv,iFont);
  1905.    fStatus:= iStatus;
  1906. END;
  1907.  
  1908. FUNCTION TToggleButton.ButtonInfo : Str255;
  1909. BEGIN
  1910.    IF fStatus = toggleOff
  1911.       THEN ButtonInfo:= 'Toggle button, now OFF'
  1912.       ELSE ButtonInfo:= 'Toggle button, now ON';
  1913. END;
  1914.  
  1915. FUNCTION TToggleButton.ExtraHeight : INTEGER;
  1916. BEGIN  ExtraHeight:= 4; END;
  1917.  
  1918. PROCEDURE TToggleButton.Draw;
  1919. VAR   r  :  Rect;
  1920. BEGIN
  1921.    GetRectangle(r);
  1922.    InsetRect(r,-1,-1);
  1923.    EraseRect(r);
  1924.    FrameRoundRect(r,ovalSize,ovalSize);
  1925.    InsetRect(r,2,2);
  1926.    IF fStatus = toggleOn THEN
  1927.       FrameRoundRect(r,ovalSize,ovalSize);
  1928.    InsetRect(r,1+ovalSize,1);
  1929.    DrawTitle(r);
  1930. END;
  1931.  
  1932. FUNCTION TToggleButton.Click
  1933.          (p : Point;  modif : INTEGER) : LongInt;
  1934. VAR   result  :  INTEGER;
  1935. BEGIN
  1936.    result:= INHERITED Click(p,modif);
  1937.    IF result = fItsValue THEN BEGIN
  1938.       fStatus:= toggleOn - fStatus;
  1939.       Draw;
  1940.    END;
  1941.    Click:= result;
  1942. END;
  1943.  
  1944. PROCEDURE TToggleButton.VisualFeedback;
  1945. BEGIN
  1946.    INHERITED VisualFeedback;
  1947.    fStatus:= toggleOn - fStatus;
  1948.    Draw;
  1949. END;
  1950.  
  1951. {••••••••••••••••••••••••••••••••••••••••••••••••}
  1952. { METHODS OF OBJECT TYPE “TThreeDButton”.        }
  1953. {••••••••••••••••••••••••••••••••••••••••••••••••}
  1954. PROCEDURE TThreeDButton.IThreeDButton
  1955.           (iBorder : Rect; iTitle : Str15;
  1956.            iEquiv : CHAR;   iFont : FontIdent);
  1957. BEGIN
  1958.    IPlainButton(iBorder,iTitle,iEquiv,iFont);
  1959. END;
  1960.  
  1961. FUNCTION TThreeDButton.ButtonInfo : Str255;
  1962. BEGIN ButtonInfo:= 'Three-dimensional button';END;
  1963.  
  1964. FUNCTION TThreeDButton.ExtraHeight : INTEGER;
  1965. BEGIN  ExtraHeight:= 12; END;
  1966.  
  1967. PROCEDURE TThreeDButton.FancyBorder(r : Rect;
  1968.                               hilited : BOOLEAN);
  1969. VAR   i  :  INTEGER;
  1970. BEGIN
  1971.    FrameRect(r);
  1972.    IF hilited THEN BEGIN
  1973.       FOR i:= 1 TO 2 DO BEGIN
  1974.          InsetRect(r,1,1);
  1975.          PenPat( gray); FrameTop(r);
  1976.          PenPat(black); FrameBot(r);
  1977.       END;
  1978.       FOR i:= 1 TO 2 DO BEGIN
  1979.          InsetRect(r,1,1);
  1980.          PenPat(black); FrameTop(r);
  1981.          PenPat( gray); FrameBot(r);
  1982.       END;
  1983.    END
  1984.    ELSE BEGIN
  1985.       PenPat(gray);
  1986.       FOR i:= 1 TO 2 DO BEGIN
  1987.          InsetRect(r,1,1);
  1988.          FrameBot(r);
  1989.       END;
  1990.       FOR i:= 1 TO 2 DO BEGIN
  1991.          InsetRect(r,1,1);
  1992.          FrameTop(r);
  1993.       END;
  1994.    END;
  1995.    PenNormal;
  1996.    InsetRect(r,1,1); FrameRect(r);
  1997. END;
  1998.  
  1999. PROCEDURE TThreeDButton.DropShadow(r : Rect;
  2000.                                depth : INTEGER);
  2001. BEGIN
  2002.    WHILE depth > 0 DO BEGIN
  2003.       OffsetRect(r,1,1);
  2004.       FrameBot(r);
  2005.       depth:= depth - 1;
  2006.    END;
  2007. END;
  2008.  
  2009. PROCEDURE TThreeDButton.Draw;
  2010. VAR   r  :  Rect;
  2011. BEGIN
  2012.    GetRectangle(r);
  2013.    EraseRect(r);         {Clean up first}
  2014.    FancyBorder(r,FALSE);
  2015.    DropShadow(r,shadow3Doff);
  2016.    InsetRect(r,6,6);
  2017.    DrawTitle(r);
  2018. END;
  2019.  
  2020. PROCEDURE TThreeDButton.PushDown(VAR r : Rect;
  2021.                                  depth : INTEGER);
  2022. VAR   x  :  LongInt;
  2023.       rgn  :  RgnHandle;
  2024. BEGIN
  2025.    rgn:= NewRgn;
  2026.    WHILE depth > 0 DO BEGIN
  2027.       Delay(threeDDelay,x);
  2028.       ScrollRect(r,1,1,rgn);
  2029.       OffsetRect(r,1,1);
  2030.       depth:= depth - 1;
  2031.    END;
  2032.    DisposeRgn(rgn);
  2033. END;
  2034.  
  2035. PROCEDURE TThreeDButton.PopUp(VAR r : Rect;
  2036.                               depth : INTEGER);
  2037. VAR   x  :  LongInt;
  2038.       rgn  :  RgnHandle;
  2039. BEGIN
  2040.    rgn:= NewRgn;
  2041.    WHILE depth > 0 DO BEGIN
  2042.       Delay(threeDDelay,x);
  2043.       ScrollRect(r,-1,-1,rgn);
  2044.       FrameBot(r);
  2045.       OffsetRect(r,-1,-1);
  2046.       FrameTop(r);
  2047.       depth:= depth - 1;
  2048.    END;
  2049.    DisposeRgn(rgn);
  2050. END;
  2051.  
  2052. FUNCTION TThreeDButton.MouseReleasedHere:BOOLEAN;
  2053. VAR   p  :  Point;
  2054.       r  :  Rect;
  2055.       inside  :  MouseFlags;
  2056. BEGIN
  2057.    GetRectangle(r);
  2058.    inside[before]:= TRUE;
  2059.    PushDown(r,shadow3Doff);
  2060.    REPEAT
  2061.       GetMouse(p);
  2062.       inside[now]:= PtInRect(p,r);
  2063.       IF inside[now] <> inside[before] THEN BEGIN
  2064.          IF inside[before]
  2065.             THEN PopUp(r,shadow3Doff)
  2066.             ELSE PushDown(r,shadow3Doff);
  2067.          inside[before]:= inside[now];
  2068.       END;
  2069.    UNTIL NOT StillDown;
  2070.    MouseReleasedHere:= inside[now];
  2071.    IF inside[now] THEN PopUp(r,shadow3Doff);
  2072. END;
  2073.  
  2074. PROCEDURE TThreeDButton.VisualFeedback;
  2075. VAR   r  :  Rect;
  2076.       x  :  LongInt;
  2077. BEGIN
  2078.    GetRectangle(r);
  2079.    PushDown(r,shadow3Doff);
  2080.    Delay(feedbackDelay,x);
  2081.    PopUp(r,shadow3Doff);
  2082. END;
  2083.  
  2084. {••••••••••••••••••••••••••••••••••••••••••••••••}
  2085. { METHODS OF OBJECT TYPE “TToggl3DButton”.       }
  2086. {••••••••••••••••••••••••••••••••••••••••••••••••}
  2087. PROCEDURE TToggl3DButton.IToggl3DButton
  2088.             (iBorder : Rect;
  2089.               iTitle : Str15;
  2090.               iEquiv : CHAR;
  2091.                iFont : FontIdent;
  2092.              iStatus : INTEGER);
  2093. BEGIN
  2094.    IPlainButton(iBorder,iTitle,iEquiv,iFont);
  2095.    fStatus:= iStatus;
  2096. END;
  2097.  
  2098. FUNCTION TToggl3DButton.ButtonInfo : Str255;
  2099. VAR   s  :  String[3];
  2100. BEGIN
  2101.    IF fStatus = toggleOff THEN s:= 'OFF'
  2102.                           ELSE s:= 'ON';
  2103.    ButtonInfo:= Concat(
  2104.       'Three-dimensional toggle button, now ',s);
  2105. END;
  2106.  
  2107. PROCEDURE TToggl3DButton.Draw;
  2108. VAR   r  :  Rect;
  2109. BEGIN
  2110.    IF fStatus = toggleOff THEN INHERITED Draw
  2111.    ELSE BEGIN
  2112.       GetRectangle(r);
  2113.       EraseRect(r);
  2114.       OffsetRect(r,shadow3Ddiff,shadow3Ddiff);
  2115.       FancyBorder(r,TRUE);
  2116.       DropShadow(r,shadow3Don);
  2117.       InsetRect(r,6,6);
  2118.       DrawTitle(r);
  2119.    END;
  2120. END;
  2121.  
  2122. FUNCTION TToggl3DButton.MouseReleasedHere:BOOLEAN;
  2123. VAR   r  :  Rect;
  2124.       inside  :  MouseFlags;
  2125.    PROCEDURE LocalTrackMouse(oldHeight,
  2126.                          toggledHeight : INTEGER);
  2127.    VAR   p  :  Point;
  2128.    BEGIN
  2129.       PushDown(r,oldHeight);
  2130.       REPEAT
  2131.          GetMouse(p);
  2132.          inside[now]:= PtInRect(p,r);
  2133.          IF inside[now] <> inside[before] THEN
  2134.          BEGIN
  2135.             IF inside[before]
  2136.                THEN PopUp(r,oldHeight)
  2137.                ELSE PushDown(r,oldHeight);
  2138.             inside[before]:= inside[now];
  2139.          END;
  2140.       UNTIL NOT StillDown;
  2141.       IF inside[now] THEN PopUp(r,toggledHeight);
  2142.    END;
  2143. BEGIN
  2144.    GetRectangle(r);
  2145.    inside[before]:= TRUE;
  2146.    IF fStatus = toggleOff THEN
  2147.       LocalTrackMouse(shadow3Doff,shadow3Don)
  2148.    ELSE BEGIN
  2149.       OffsetRect(r,shadow3Ddiff,shadow3Ddiff);
  2150.       LocalTrackMouse(shadow3Don,shadow3Doff);
  2151.    END;
  2152.    MouseReleasedHere:= inside[now];
  2153. END;
  2154.  
  2155. FUNCTION TToggl3DButton.Click
  2156.          (p : Point;  modif : INTEGER) : LongInt;
  2157. VAR   result  :  INTEGER;
  2158. BEGIN
  2159.    result:= INHERITED Click(p,modif);
  2160.    IF result = fItsValue THEN BEGIN
  2161.       fStatus:= toggleOn - fStatus;
  2162.       Draw;
  2163.    END;
  2164.    Click:= result;
  2165. END;
  2166.  
  2167. PROCEDURE TToggl3DButton.VisualFeedback;
  2168. VAR   r  :  Rect;
  2169.       x  :  LongInt;
  2170. BEGIN
  2171.    GetRectangle(r);
  2172.    IF fStatus = toggleOff THEN BEGIN
  2173.       PushDown(r,shadow3Doff);
  2174.       Delay(feedbackDelay,x);
  2175.       PopUp(r,shadow3Don);
  2176.    END
  2177.    ELSE BEGIN
  2178.       OffsetRect(r,shadow3Ddiff,shadow3Ddiff);
  2179.       PushDown(r,shadow3Don);
  2180.       Delay(feedbackDelay,x);
  2181.       PopUp(r,shadow3Doff);
  2182.    END;
  2183.    fStatus:= toggleOn - fStatus;
  2184.    Draw;
  2185. END;
  2186.  
  2187. {••••••••••••••••••••••••••••••••••••••••••••••••}
  2188. { METHODS OF OBJECT TYPE “TIcon”.                }
  2189. {••••••••••••••••••••••••••••••••••••••••••••••••}
  2190. PROCEDURE TIcon.IIcon(iBorder : Rect;
  2191.                       iIconID : INTEGER);
  2192. BEGIN
  2193.    WITH iBorder DO BEGIN
  2194.       right:= left + 32;
  2195.       bottom:= top + 32;
  2196.    END;
  2197.    IPDialogItem(iBorder);
  2198.    fIconID:= iIconID;
  2199. END;
  2200.  
  2201. FUNCTION TIcon.Information : Str255;
  2202. VAR   s  :  Str255;
  2203. BEGIN
  2204.    s:= Concat('Icon, resource id = ',
  2205.       IntString(fIconID),', ');
  2206.    IF fFlag[enable]
  2207.       THEN s:= Concat(s,'now visible')
  2208.       ELSE s:= Concat(s,'now invisible');
  2209.    Information:= s;
  2210. END;
  2211.  
  2212. { “fFlag[enable]” controls showing/hiding. }
  2213. PROCEDURE TIcon.Draw;
  2214. VAR   r  :  Rect;
  2215.       h  :  Handle;
  2216. BEGIN
  2217.    GetRectangle(r);
  2218.    IF fFlag[enable] THEN BEGIN
  2219.       h:= GetResource('ICN#',fIconID);
  2220.       IF h <> NIL THEN PlotIcon(r,h);
  2221.    END
  2222.    ELSE EraseRect(r);
  2223. END;
  2224.  
  2225. {••••••••••••••••••••••••••••••••••••••••••••••••}
  2226. { METHODS OF OBJECT TYPE “TAnimation”.           }
  2227. {••••••••••••••••••••••••••••••••••••••••••••••••}
  2228. PROCEDURE TAnimation.IAnimation(iBorder:Rect;
  2229.                                 iBaseID:INTEGER;
  2230.                                 iNumber:INTEGER);
  2231. BEGIN
  2232.    IPDialogItem(iBorder);
  2233.    fFlag[enable]:= TRUE;   {Override the default}
  2234.    fBaseID := iBaseID;
  2235.    fNumber := iNumber;
  2236.    fCurrent:= 1;
  2237.    fForward:= TRUE;
  2238.    fLastTim:= 0;
  2239. END;
  2240.  
  2241. FUNCTION TAnimation.Information : Str255;
  2242. VAR   s  :  Str255;
  2243. BEGIN
  2244.    IF fFlag[animate] THEN s:= 'Animation ON, '
  2245.                      ELSE s:= 'Animation OFF, ';
  2246.    s:= Concat(s,'currently #',
  2247.       IntString(fCurrent),' of ');
  2248.    s:= Concat(s,IntString(fNumber),' frames.');
  2249.    Information:= s;
  2250. END;
  2251.  
  2252. PROCEDURE TAnimation.NextFrame;
  2253. BEGIN
  2254.    IF fForward THEN BEGIN
  2255.       fCurrent:= fCurrent + 1;
  2256.       IF fCurrent > fNumber THEN BEGIN
  2257.          fCurrent:= fNumber;
  2258.          fForward:= FALSE;
  2259.       END;
  2260.    END
  2261.    ELSE BEGIN
  2262.       fCurrent:= fCurrent - 1;
  2263.       IF fCurrent < 1 THEN BEGIN
  2264.          fCurrent:= 1;
  2265.          fForward:= TRUE;
  2266.       END;
  2267.    END;
  2268. END;
  2269.  
  2270. PROCEDURE TAnimation.Idle;
  2271. VAR   x  :  LongInt;
  2272. BEGIN
  2273.    IF fFlag[animate] THEN BEGIN
  2274.       x:= TickCount;
  2275.       IF x - fLastTim >= animThreshold THEN BEGIN
  2276.          NextFrame;
  2277.          Draw;
  2278.          fLastTim:= x;
  2279.       END;
  2280.    END;
  2281.    INHERITED Idle;
  2282. END;
  2283.  
  2284. { “TAnimation.Draw” draws the picture
  2285.   horizontally centred in and at bottom of "r".}
  2286. PROCEDURE TAnimation.Draw;
  2287. VAR   p  :  PicHandle;
  2288.       x,y  :  INTEGER;
  2289.       r,rPic  :  Rect;
  2290. BEGIN
  2291.    GetRectangle(r);
  2292.    EraseRect(r);
  2293.    p:= GetPicture(fBaseID+fCurrent);
  2294.    IF p = NIL THEN Exit(Draw);
  2295.    rPic:= p^^.picFrame;
  2296.    WITH r DO x:= (left + right) DIV 2;
  2297.    WITH rPic DO x:= x - ((left + right) DIV 2);
  2298.    y:= r.bottom - rPic.bottom;
  2299.    OffsetRect(rPic,x,y);
  2300.    DrawPicture(p,rPic);
  2301. END;
  2302.  
  2303. {••••••••••••••••••••••••••••••••••••••••••••••••}
  2304. { METHODS OF OBJECT TYPE “TStaticText”           }
  2305. {••••••••••••••••••••••••••••••••••••••••••••••••}
  2306. PROCEDURE TStaticText.IStaticText
  2307.           (iBorder : Rect; iFont : FontIdent;
  2308.            iContents : Str255);
  2309. BEGIN
  2310.    IPDialogItem(iBorder);
  2311.    fFlag[enable]:= TRUE;   {Override the default}
  2312.    fFont:= iFont;
  2313.    fContents:= iContents;
  2314. END;
  2315.  
  2316. FUNCTION TStaticText.Information : Str255;
  2317. VAR   s  :  Str255;
  2318. BEGIN
  2319.    s:= fContents;
  2320.    s:= IntString(Length(s));
  2321.    Information:=
  2322.       Concat('Static text item of length ',s);
  2323. END;
  2324.  
  2325. PROCEDURE TStaticText.DrawBorder;
  2326. VAR   r  :  Rect;
  2327. BEGIN
  2328.    GetRectangle(r);
  2329.    IF fFlag[active] THEN FrameRect(r)
  2330.    ELSE BEGIN
  2331.       PenPat(gray);
  2332.       FrameRect(r);
  2333.       PenPat(black);
  2334.    END;
  2335. END;
  2336.  
  2337. PROCEDURE TStaticText.Draw;
  2338. VAR   s  :  Str255;
  2339.       r  :  Rect;
  2340.       saveFont,
  2341.       textFont  :  FontIdent;
  2342. BEGIN
  2343.    DrawBorder;
  2344.    s:= fContents;
  2345.    GetFontIdent(saveFont);
  2346.    textFont:= fFont;
  2347.    SetFontIdent(textFont);
  2348.    GetRectangle(r);
  2349.    InsetRect(r,1,1);
  2350.    TextBox(Ptr(ORD(@s)+1),Length(s),r,
  2351.       teJustCenter);
  2352.    SetFontIdent(saveFont);
  2353. END;
  2354.  
  2355. PROCEDURE TStaticText.ActivateIt;
  2356. BEGIN
  2357.    fFlag[active]:= TRUE;
  2358.    DrawBorder;
  2359.    INHERITED ActivateIt;
  2360. END;
  2361.  
  2362. PROCEDURE TStaticText.DeactivateIt;
  2363. BEGIN
  2364.    fFlag[active]:= FALSE;
  2365.    DrawBorder;
  2366.    INHERITED DeactivateIt;
  2367. END;
  2368.  
  2369. END.
  2370.